(*
   Utilise par get_contour.
   Compare la couleur des voisins d'un pixel a sa couleur.
   Renvoie Sdlvideo.black si un voisin a une couleur differente.
   Renvoie la couleur du pixel si tous ses voisins sont de sa couleur.
*)
let test_contour img_base mtrx_base img_cntr mtrx_cntr x y w h =
  let color = Sdlvideo.get_pixel_color img_base x y in
    mtrx_base.(x).(y) <- color;
    let result = ref true in
    let nbtest = ref 0 in
    let colortest = ref Sdlvideo.white in
      while (!result && !nbtest < 5) do
	nbtest := !nbtest + 1;
	if (!nbtest = 1 && (x - 1) >= 0) then
	  begin
	    colortest := Sdlvideo.get_pixel_color img_base (x - 1) y;
	    result := (color = !colortest);
	  end
	else if (!nbtest = 2 && (x + 1) <= w) then
	  begin
	    colortest := Sdlvideo.get_pixel_color img_base (x + 1) y;
	    result := (color = !colortest);
	  end
	else if (!nbtest = 3 && (y - 1) >= 0) then
	  begin
	    colortest := Sdlvideo.get_pixel_color img_base x (y - 1);
	    result := (color = !colortest);
	  end
	else if (!nbtest = 4 && (y + 1) <= h) then
	  begin
	    colortest := Sdlvideo.get_pixel_color img_base x (y + 1);
	    result := (color = !colortest);
	  end
      done;
      if !result then
	begin
	  mtrx_cntr.(x).(y) <- color;
	  color
	end
      else
	Sdlvideo.black

(*
  Cree l'image avec les contours ('img_cntr').
  Cree les matrices de couleur correspondant a l'image de base et a celle
  avec les contours.
*)
let get_contour img_base mtrx_base img_cntr mtrx_cntr w h =
  for x = 0 to (w - 1) do
    for y = 0 to (h - 1) do
      Sdlvideo.put_pixel_color img_cntr x y
	(test_contour img_base mtrx_base img_cntr mtrx_cntr x y w h);
    done;
  done

(*
  Cette fonction verifie d'abord que l'on ne sort pas des limites de la
  matrice, puis change la valeur de la case de la matrice si celle-ci
  etait superieur a la nouvelle valeur donnee en parametre
*)
let set_value dmtrx x y new_value =
  if (x >= 0 && x < Array.length dmtrx) then
    if (y >= 0 && y < Array.length dmtrx.(1)) then
      let (new_dist, new_pref) = new_value in
      let (act_dist, act_pref) = dmtrx.(x).(y) in
	if (act_dist < 0.0 || act_dist >= new_dist) then
	  dmtrx.(x).(y) <- new_value

(*
  Cette fonction est utilise par get_mtrx_high et search_high_ref.
  Elle trouve la hauteur correspondant a une couleur.
*)
let rec search_high color legend = match legend with
  | [] -> 1000.0      (* erreur *)
  | (c,h)::l -> if (c = color) then
      h
    else
      search_high color l

(*
  Cette fonction est utilise par get_mtrx_high. Elle trouve la hauteur
  moyenne d'un point donne.
*)
let search_high_ref mtrx (x, y) (w, h) legend =
  let color = mtrx.(x).(y) in
  let nbcolors = ref 1 in
  let colors = Array.make 9 color in
    if ((x - 1) >= 0) then
      begin
        colors.(!nbcolors) <- mtrx.(x-1).(y);
	nbcolors := !nbcolors + 1;
	if ((y + 1) < h) then
	  begin
	    colors.(!nbcolors) <- mtrx.(x-1).(y+1);
	    nbcolors := !nbcolors + 1;
	  end
	else ();
	if ((y - 1) >= 0) then
	  begin
	    colors.(!nbcolors) <- mtrx.(x-1).(y-1);
	    nbcolors := !nbcolors + 1;
	  end
	else ();
      end
    else ();
    if ((x + 1) < w) then
      begin
	colors.(!nbcolors) <- mtrx.(x+1).(y);
	nbcolors := !nbcolors + 1;
	if ((y + 1) < h) then
	  begin
	    colors.(!nbcolors) <- mtrx.(x+1).(y+1);
	    nbcolors := !nbcolors + 1;
	  end
	else ();
	if ((y - 1) >= 0) then
	  begin
	    colors.(!nbcolors) <- mtrx.(x+1).(y-1);
	    nbcolors := !nbcolors + 1;
	  end
	else ();
      end
    else ();
    if ((y - 1) >= 0) then
      begin
	colors.(!nbcolors) <- mtrx.(x).(y-1);
	nbcolors := !nbcolors + 1
      end
    else ();
    if ((y + 1) < h) then
      begin
	colors.(!nbcolors) <- mtrx.(x).(y+1);
	nbcolors := !nbcolors + 1
      end
    else ();
    let total = ref 0.0 in
    let div = ref 1.0 in
    let highs = Array.make 9 (search_high colors.(0) legend) in
      total := !total +. highs.(0);
      for i = 1 to (!nbcolors-1) do
	let high = search_high colors.(i) legend in
	  if (high <> highs.(0) &&
			high <> highs.(1) &&
			high <> highs.(2) &&
			high <> highs.(3) &&
			high <> highs.(4) &&
			high <> highs.(5) &&
			high <> highs.(6) &&
			high <> highs.(7) &&
			high <> highs.(8)) then
	    begin
	      highs.(i) <- high;
	      div := !div +. 1.0;
	      total := !total +. high
	    end
	  else ();
      done;
      !total /. !div

let get_mtrx_disthigh mtrx_base mtrx_cntr mtrx_dist mtrx_high legend w h =
  let mask = [| (1, 0, 5.0) ; (1, 1, 7.0) ; (2, 1, 11.0) |] in
    (*
      Creation et initialisation d'une matrice :
      distance : -1.0
      pixel de reference : (0, 0)
    *)
  let dmtrx = Array.init w (fun _ -> Array.make h (-1.0, (0, 0))) in
    (*
      Si la case de la matrice donnee en parametre represente un pixel
      noir, la valeur de la case de la nouvelle matrice est mise :
      distance : 0.0
      pixel de reference : (i, j)  (eux meme)
    *)
    for i = 0 to (w - 1) do
      for j = 0 to (h - 1) do
	if (mtrx_cntr.(i).(j) = Sdlvideo.black) then
	  dmtrx.(i).(j) <- (0.0, (i, j))
	else ();
      done;
    done;
    (*
      Premier passage pour le calcul des distances et du pixel de
      reference
    *)
    for i = 0 to (w - 1) do
      for j = 0 to (h - 1) do
	let (dist, pref) = dmtrx.(i).(j) in
	  if (dist >= 0.0) then
	    for k = 0 to 2 do
	      let (dw, dh, dp) = mask.(k) in
		set_value dmtrx (i + dw) (j + dh) ((dist+.dp), pref);
		if (dh <> 0) then
		  set_value dmtrx (i - dw) (j + dh) ((dist+.dp), pref)
		else ();
		if (dh <> dw) then
		  set_value dmtrx (i + dh) (j + dw) ((dist+.dp), pref)
		else ();
		if (dh <> dw && dh <> 0) then
		  set_value dmtrx (i - dh) (j + dw) ((dist+.dp), pref)
		else ();
	    done
	  else ();
      done;
    done;
    (*
      Deuxieme passage dans l'autre sens
    *)
    for i = (w - 1) downto 0 do
      for j = (h - 1) downto 0 do
	let (dist, pref) = dmtrx.(i).(j) in
	  if (dist >= 0.0) then
	    for k = 0 to 2 do
	      let (dw, dh, dp) = mask.(k) in
		set_value dmtrx (i - dw) (j - dh) ((dist+.dp), pref);
		set_value dmtrx (i + 1) (j) ((dist+.5.0), pref);
		set_value dmtrx (i - 1) (j) ((dist+.5.0), pref);
		if (dh <> 0) then
		  set_value dmtrx (i + dw) (j - dh) ((dist+.dp), pref)
		else ();
		if (dh <> dw) then
		  set_value dmtrx (i - dh) (j - dw) ((dist+.dp), pref)
		else ();
		if (dh <> dw && dh <> 0) then
		  set_value dmtrx (i + dh) (j - dw) ((dist+.dp), pref)
		else ();
	    done
	  else ();
      done;
    done;
    dmtrx

let  gt_dist mtrx_base mtrx_dist mtrx_high w h dmtrx legend =
    for i = 0 to (w - 1) do
      for j = 0 to (h - 1) do
	let (dist, pref) = dmtrx.(i).(j) in
	  mtrx_dist.(i).(j) <- (dist /. 5.);
	  mtrx_high.(i).(j) <- ((search_high mtrx_base.(i).(j) legend),
			(search_high_ref mtrx_base pref (w, h) legend));
      done;
    done

let rec convert i array list = match list with
    [] -> ()
  | hd::l -> array.(i) <- hd; convert (i+1) array l

let parse path =
  let canal = open_in path in
  let listline = Array.make 50 "" in
  let legend = ref [] in
  let l = ref (input_line canal) in
  let i = ref 0 in
    while (!l <> " ") do
      listline.(!i) <- !l;
      i := !i + 1;
      l := input_line canal;
    done;
    let j = ref 0 in
      while !j < !i do
	let hd = listline.(!j) in
	  j := !j + 1;
	  let split = Str.split (Str.regexp " ") hd in
	  let splitarray = Array.make 5 "" in
	    convert 0 splitarray split;
	    let r = int_of_string splitarray.(0) in
	    let g = int_of_string splitarray.(1) in
	    let b = int_of_string splitarray.(2) in
	    let h = float_of_string splitarray.(4) in
	    let newvalue = ((r,g,b), h) in
              legend := newvalue::!legend;
      done;
      List.rev !legend

let get_dims img = ((Sdlvideo.surface_info img).Sdlvideo.w,
		    (Sdlvideo.surface_info img).Sdlvideo.h)

let sdl_init () =
  Sdl.init [`EVERYTHING];
  Sdlevent.enable_events Sdlevent.all_events_mask

let compute img_path legend_path outpath =
    sdl_init ();
    let legend = parse legend_path in
    let img_base = Sdlloader.load_image img_path in
    let (w, h) = get_dims img_base in
    let img_cntr = Sdlvideo.create_RGB_surface_format img_base [] w h in
    let mtrx_base = Array.init w (fun _ -> Array.make h Sdlvideo.white) in
	let mtrx_cntr = Array.init w (fun _ -> Array.make h Sdlvideo.black) in
	  get_contour img_base mtrx_base img_cntr mtrx_cntr w h;
	  Sdlvideo.save_BMP img_cntr (outpath);
	  let mtrx_dist = Array.init w (fun _ -> Array.make h 0.0) in
	  let mtrx_high = Array.init w (fun _ -> Array.make h (0.0,0.0)) in
          let dmtrx = get_mtrx_disthigh
	      mtrx_base
	      mtrx_cntr
	      mtrx_dist
	      mtrx_high
	      legend w h
          in
            (img_base,
             mtrx_high,
             mtrx_dist,
             w, h, legend,
             gt_dist mtrx_base
               mtrx_dist mtrx_high w h dmtrx)
